PD ROM 1/PD ROM Volume I - Macintosh Software from BMUG (1988).iso/Programming/Complete Applications/Screen Savers/Moire (Pascal)/MOIRE.PAS

Pascal/Delphi Source File | 1986-10-22 | 14.1 KB | 706 lines | [TEXT/ttxt]

PROGRAM MOIRE;

USES MacIntf,MOIREGLOBALS,ZOOM,MOIREINIT;

{$T APPL MRGB            }
{$B+                        }
{$L MOIRE.RSRC        }

PROCEDURE UpdateEdit (OnOFf : boolean);
VAR
        index : integer;
BEGIN
    FOR index := 1 TO 6 DO
        IF OnOff THEN
            EnableItem(EditMenu, index)
        ELSE
            DisableItem(EditMenu, index);
END;

PROCEDURE DrawHeading (theW : WindowPtr);
    VAR
        theStr : str255;
BEGIN
    theStr := 'Click anywhere in the window to set the origin point';
    SetPort(theW);
    TextFont(3);
    TextSize(9);
    WITH theW^.portRect DO
        BEGIN
            MoveTo((right - left - StringWidth(theStr)) DIV 2, topLine - 6);
            DrawString(theStr);
            MoveTo(left, top + topLine - 3);
            LineTo(right, top + topLine - 3);
            MoveTo(left, top + topLine - 1);
            LineTo(right, top + topLine - 1);
        END;
END;

PROCEDURE DrawMoire (thePoint : point;
                                theWindow : WindowPtr);
    VAR
        x1, y1, x2, y2 : integer;
        vRect : rect;
        tempPort : WindowPtr;
BEGIN
    getPort(tempPort);
    setPort(theWindow);
    PenNormal;
    PenMode(patXor);
    CASE CurrentPat OF
        3 :
            PenPat(black);
        4 :
            PenPat(dkGray);
        5 :
            PenPat(gray);
        6 :
            PenPat(ltGray);
    END;
    x1 := thePoint.h;
    y1 := thePoint.v;
    clipRect(MoireRect);
    IF flashPhase THEN
        InvertRect(MoireRect);
    HideCursor;
    WITH MoireRect DO
        BEGIN
            x2 := right;
            y2 := top;
            WHILE x2 >= left DO
                BEGIN
                    MoveTo(x1, y1);
                    LineTo(x2, y2);
                    x2 := x2 - step;
                END;
            WHILE y2 <= bottom DO
                BEGIN
                    MoveTo(x1, y1);
                    LineTo(x2, y2);
                    y2 := y2 + step;
                END;
            WHILE x2 <= right DO
                BEGIN
                    MoveTo(x1, y1);
                    LineTo(x2, y2);
                    x2 := x2 + step;
                END;
            WHILE y2 >= top DO
                BEGIN
                    MoveTo(x1, y1);
                    LineTo(x2, y2);
                    y2 := y2 - step;
                END;
        END;
    ShowCursor;
    flashVal := tickCount;
    PenNormal;
    clipRect(theWindow^.portRect);
    setPort(tempPort);
END;

PROCEDURE CheckFlash;
    VAR
        tempPort : WindowPtr;
        flashRect : rect;
BEGIN
    IF (tickCount - flashVal) >= flashRate THEN
        BEGIN
            GetPort(tempPort);
            SetPort(myWindow);
            invertRect(MoireRect);
            flashPhase := NOT flashPhase;
            flashVal := tickCount;
            setPort(tempPort);
        END;
END;

PROCEDURE DoAppleMenu (theItem : integer);
    VAR
        ignore : integer;
        accName : Str255;
        accNum : integer;
BEGIN
    IF theItem = 1 THEN
        BEGIN
            ignore := Alert(AboutID, NIL);
        END
    ELSE
        BEGIN
            GetItem(AppleMenu, theItem, accName);
            accNum := OpenDeskAcc(accName);
        END;
END;

PROCEDURE DoFileMenu (theItem : integer);
BEGIN
    CASE theItem OF
        1 :
            BEGIN
                Finished := TRUE;
            END;
    END;
END;

PROCEDURE DoEditMenu (theItem : integer);
BEGIN
    IF NOT SystemEdit(theItem - 1) THEN
        BEGIN
            CASE theItem OF
                UndoItem :
                    ;
                { Undo PROCEDURE }
                CutItem :
                    ;
                { Cut PROCEDURE }
                CopyItem :
                    ;
                { Copy PROCEDURE }
                PasteItem :
                    ;
                { Paste PROCEDURE }
                ClearItem :
                    ;
                { Clear PROCEDURE }
            END;
        END;
END;

FUNCTION MyPatDlg (theDialog : DialogPtr;
                                VAR dEvent : EventRecord;
                                VAR itemHit : integer) : boolean;
    VAR
        ch : integer;
        thePoint : point;
        ItemIndex : integer;
        dType : integer;
        dHandle : Handle;
        dRect : rect;

    PROCEDURE MakeWhite (dItem : integer);
    BEGIN
        GetDItem(theDialog, dItem, dType, dHandle, dRect);
        insetRect(dRect, -4, -4);
        PenSize(2, 2);
        PenPat(white);
        FrameRect(dRect);
    END;

    PROCEDURE MakeBlack (dItem : integer);
    BEGIN
        GetDItem(theDialog, dItem, dType, dHandle, dRect);
        insetRect(dRect, -4, -4);
        PenSize(2, 2);
        PenPat(black);
        FrameRect(dRect);
    END;

BEGIN
    SetPort(theDialog);

(*  check to see if it's time to flash selection  *)

    IF (tickCount - timeVal) > dflashRate THEN
        BEGIN
            GetDItem(theDialog, tempPat, dType, dHandle, dRect);
            InsetRect(dRect, -4, -4);
            PenSize(2, 2);
            PenMode(patXor);
            FrameRect(dRect);
            PenNormal;
            timeVal := tickCount;
        END;

(* assume that we'll handle these events *)
    MyPatDlg := FALSE;

(* find out what kind of event *)
    CASE dEvent.what OF
        MouseDown :

(* check if mouse click was in any of the selectable items *)
(* by calling PtInRect(mouseclick,itemrect)                *)

            BEGIN
                thePoint := dEvent.where;
                GlobalToLocal(thePoint);
                FOR ItemIndex := 3 TO 6 DO
                    BEGIN
                        GetDItem(theDialog, ItemIndex, dType, dHandle, dRect);
                        IF PtInRect(thePoint, dRect) THEN
                            BEGIN
                                IF ItemIndex <> tempPat THEN

(* if it was, user made new selection, so...   *)
(* clear out old selection, make new selection *)

                                    BEGIN
                                        MakeWhite(tempPat);
                                        tempPat := ItemIndex;
                                        MakeBlack(tempPat);
                                        timeVal := tickCount;
                                    END;
                            END;
                    END;
            END;

(* check keydown events for "RETURN" (13)       *)
(* and "ENTER" (03) keys, if so let ModalDialog *)
(* handle them by passing function result of    *)
(* TRUE and an itemHit of 1                     *)

        KeyDown :
            BEGIN
                ch := BitAnd(dEvent.message, CharCodeMask);
                CASE ch OF
                    13, 3 :
                        BEGIN
                            ItemHit := 1;
                            MyPatDlg := TRUE;
                        END;

(* if not "RETURN" or "ENTER", let user make    *)
(* selection from keyboard using the arrow keys *)

                    28 :
                        IF (tempPat = 5) OR (tempPat = 6) THEN
                            BEGIN
                                MakeWhite(tempPat);
                                tempPat := tempPat - 2;
                                MakeBlack(tempPat);
                                timeVal := tickCount;
                            END;
                    29 :
                        IF (tempPat = 3) OR (tempPat = 4) THEN
                            BEGIN
                                MakeWhite(tempPat);
                                tempPat := tempPat + 2;
                                MakeBlack(tempPat);
                                timeVal := tickCount;
                            END;
                    30 :
                        IF (tempPat = 4) OR (tempPat = 6) THEN
                            BEGIN
                                MakeWhite(tempPat);
                                tempPat := tempPat - 1;
                                MakeBlack(tempPat);
                                timeVal := tickCount;
                            END;
                    31 :
                        IF (tempPat = 3) OR (tempPat = 5) THEN
                            BEGIN
                                MakeWhite(tempPat);
                                tempPat := tempPat + 1;
                                MakeBlack(tempPat);
                                timeVal := tickCount;
                            END;
                END;
            END;
    END;
END;

PROCEDURE ourItems (theWindow : WindowPtr;
                                theItem : integer);
    VAR
        dType : integer;
        dHandle : Handle;
        dRect : rect;
BEGIN
    GetDItem(theWindow, theItem, dType, dHandle, dRect);
    CASE theItem OF
        blackID :
            FillRect(dRect, black);
        dkGrayID :
            FillRect(dRect, dkGray);
        grayID :
            FillRect(dRect, gray);
        ltGrayID :
            FillRect(dRect, ltGray);
    END;
    IF theItem = tempPat THEN
        BEGIN
            insetRect(dRect, -4, -4);
            PenPat(black);
            PenSize(2, 2);
            FrameRect(dRect);
        END;
END;

PROCEDURE DoPatternMenu (theItem : integer);
    VAR
        PatternDlg : DialogPtr;
        whichItem : integer;
        bHit : integer;
        dType : integer;
        dHandle : Handle;
        dRect : rect;
        dText : Str255;
        tStep : longint;
BEGIN
    CASE theItem OF
        PatItem :
            BEGIN
                tempPat := CurrentPat;
                PatternDlg := GetNewDialog(PatternDlgID, NIL, WindowPtr(-1));
                FOR whichItem := blackID TO ltgrayID DO
                    BEGIN
                        GetDItem(PatternDlg, whichItem, dType, dHandle, dRect);
                        SetDItem(PatternDlg, whichItem, dType, @ourItems, dRect);
                    END;
                ShowWindow(PatternDlg);
                timeVal := tickCount;
                REPEAT
                    ModalDialog(@MyPatDlg, bHit);
                UNTIL bHit < 3;
                DisposDialog(PatternDlg);
                IF bHit = 1 THEN
                    BEGIN
                        IF CurrentPat <> tempPat THEN
                            BEGIN
                                CurrentPat := tempPat;
                                SetPort(myWindow);
                                InvalRect(myWindow^.portRect);
                            END;
                    END;
            END;
        StepItem :
            BEGIN
                PatternDlg := GetNewDialog(StepID, NIL, WindowPtr(-1));
                GetDItem(PatternDlg, 5, dType, dHandle, dRect);
                NumToString(Step, dText);
                SetIText(dHandle, dText);
                SelIText(PatternDlg, 5, 0, 100);
                ShowWindow(PatternDlg);
                REPEAT
                    ModalDialog(NIL, bHit);
                UNTIL bHit < 3;
                IF bHit = 1 THEN
                    BEGIN
                        GetDItem(PatternDlg, 5, dType, dHandle, dRect);
                        GetIText(dHandle, dText);
                        StringToNum(dText, tStep);
                    END;
                DisposDialog(PatternDlg);
                SetPort(myWindow);
                IF (bHit = 1) AND NOT (tStep = step) THEN
                    IF (LoWord(tStep) > 0) AND (LoWord(tStep) < 65) THEN
                        BEGIN
                            step := LoWord(tStep);
                            InvalRect(myWindow^.portRect);
                        END;
            END;
        InvertItem :
            BEGIN
                SetPort(myWindow);
                InvertRect(MoireRect);
                flashPhase := NOT flashPhase;
            END;
        FlashItem :
            BEGIN
                Flashing := NOT Flashing;
                IF Flashing THEN
                    BEGIN
                        CheckItem(PatMenu, FlashItem, TRUE);
                        HiliteControl(FlashControl, active);
                    END
                ELSE
                    BEGIN
                        CheckItem(PatMenu, FlashItem, FALSE);
                        HiliteControl(FlashControl, inactive);
                    END;
            END;
    END;
END;

PROCEDURE DoMenuChoice (theChoice : longint);
    VAR
        theMenu, theItem : integer;
BEGIN
    theMenu := HiWord(theChoice);
    theItem := LoWord(theChoice);
    CASE theMenu OF
        AppleID :
            DoAppleMenu(theItem);
        FileID :
            DoFileMenu(theItem);
        EditID :
            DoEditMenu(theItem);
        PatMenuID :
            DoPatternMenu(theItem);
    END;
    HiliteMenu(0);
END;

PROCEDURE DoMenuClick;
    VAR
        menuChoice : longint;
BEGIN
    menuChoice := MenuSelect(theEvent.where);
    DoMenuChoice(menuChoice);
END;

PROCEDURE contScroll (theControl : ControlHandle;
                                thePart : integer);
    VAR
        delta : integer;
BEGIN
    CASE thePart OF
        inUpButton :
            delta := -1;
        inDownButton :
            delta := 1;
        inPageUp :
            delta := -8;
        inPageDown :
            delta := 8;
    END;
    IF thePart <> 0 THEN
        SetCtlValue(theControl, GetCtlValue(theControl) + delta);
END;

PROCEDURE HandleScroll (theControl : ControlHandle;
                                thePart : integer;
                                thePoint : point);
    VAR
        dummy : integer;
BEGIN
    IF thePart = inThumb THEN
        BEGIN
            dummy := TrackControl(theControl, thePoint, NIL);
            flashRate := GetCtlValue(theControl);
        END
    ELSE
        BEGIN
            dummy := TrackControl(theControl, thePoint, @contScroll);
            flashRate := GetCtlValue(theControl);
        END
END;

PROCEDURE DoContent (theWindow : WindowPtr;
                                where : point);
    VAR
        theLong : longint;
        longStr : Str255;
        thePoint : point;
        thePart : integer;
        theControl : ControlHandle;
BEGIN
    IF theWindow <> FrontWindow THEN
        SelectWindow(theWindow)
    ELSE
        BEGIN
            thePoint := where;
            GlobalToLocal(thePoint);
            IF PtInRect(thePoint, MoireRect) THEN
                BEGIN
                    LastPoint := thePoint;
                    InvalRect(theWindow^.portRect)
                END
            ELSE
                BEGIN
                    thePart := FindControl(thePoint, theWindow, theControl);
                    IF theControl = FlashControl THEN
                        HandleScroll(theControl, thePart, thePoint);
                END;
        END;
END;

PROCEDURE DoDrag (theWindow : WindowPtr);
    VAR
        Limit : rect;
BEGIN
    SetRect(Limit, -32767, -32767, 32766, 32766);
    DragWindow(theWindow, theEvent.where, Limit);
END;

PROCEDURE DoGrow (theWindow : WindowPtr);
    VAR
        sizeRect : rect;
        newSize : longint;
        newWidth, newHeight : integer;
BEGIN
    IF theWindow <> FrontWindow THEN
        SelectWindow(theWindow)
    ELSE
        BEGIN
            SetRect(sizeRect, -32767, -32767, 32766, 32766);
            newSize := GrowWindow(theWindow, theEvent.where, sizeRect);
            IF newSize <> 0 THEN
                BEGIN
                    EraseRect(theWindow^.portRect);
                    newWidth := LoWord(newSize);
                    newHeight := HiWord(newSize);
                    SizeWindow(theWindow, newWidth, newHeight, TRUE);
                    InvalRect(theWindow^.portRect);
                END;
        END;
END;

PROCEDURE HandleWClose (whichWindow : WindowPtr;
                                where : point);
BEGIN
    IF whichWindow <> FrontWindow THEN
        SelectWindow(whichWindow)
    ELSE
        BEGIN
            IF TrackGoAway(whichWindow, where) THEN
                Finished := TRUE;
        END;
END;

PROCEDURE HandleMDown;
    VAR
        whichWindow : windowPtr;
        thePart : integer;
BEGIN
    whichWindow := WindowPtr(theEvent.message);
    thePart := FindWindow(theEvent.where, whichWindow);
    CASE thePart OF
        InDesk :
            sysBeep(1);
        InMenuBar :
            DoMenuClick;
        InSysWindow :
            SystemClick(theEvent, whichWindow);
        InContent :
            DoContent(whichWindow, theEvent.where);
        InDrag :
            DoDrag(whichWindow);
        InGrow :
            DoGrow(whichWindow);
        InGoAway :
            HandleWClose(whichWindow, theEvent.where);
        InZoomOut :
            BEGIN
                IF TrackBox(whichWindow, theEvent.where, InZoomOut) THEN
                    BEGIN
                        ZoomWindow(whichWindow, InZoomOut, FALSE);
                        EraseRect(whichWindow^.portRect);
                    END;
            END;
        InZoomIn :
            BEGIN
                IF TrackBox(whichWindow, theEvent.where, InZoomIn) THEN
                    BEGIN
                        ZoomWindow(whichWindow, InZoomIn, FALSE);
                        EraseRect(whichWindow^.portRect);
                    END;
            END;
    END;
END;

PROCEDURE HandleKDown;
    VAR
        chCode : integer;
        ch : char;
        menuChoice : longint;
        dummyStr : str255;
        eRect : rect;
BEGIN
    WITH theEvent DO
        BEGIN
            chCode := BitAnd(message, CharCodeMask);
            ch := CHR(chCode);
            IF BitAnd(modIFiers, CmdKey) <> 0 THEN
                BEGIN
                    IF what <> AutoKey THEN
                        BEGIN
                            menuChoice := MenuKey(ch);
                            DoMenuChoice(menuChoice);
                        END;
                END
            ELSE
                BEGIN
                END;
        END;
END;

PROCEDURE HandleUpdate;
    VAR
        ActivePort, whichWindow : WindowPtr;
BEGIN
    GetPort(ActivePort);
    whichWindow := WindowPtr(theEvent.message);
    SetPort(whichWindow);
    IF whichWindow = myWindow THEN
        BEGIN
            BeginUpdate(whichWindow);
            EraseRect(whichWindow^.portRect);
            DrawControls(whichWindow);
            DrawHeading(whichWindow);
            DrawMoire(LastPoint, whichWindow);
            EndUpdate(whichWindow);
        END;
    SetPort(ActivePort);
END;

PROCEDURE HandleActivate;
    CONST
        changeFlag = $0002;
        active = 0;
        inactive = 255;
    VAR
        whichWindow : WindowPtr;
BEGIN
    WITH theEvent DO
        BEGIN
            whichWindow := WindowPtr(message);
            SetPort(whichWindow);
            IF BitAnd(modIFiers, ActiveFlag) <> 0 THEN
                BEGIN
                    IF flashing THEN
                        HiliteControl(FlashControl, active)
                    ELSE
                        HiliteControl(FlashControl, inactive);
                    EnableItem(FileMenu, 0);
                    EnableItem(PatMenu, 0);
                    DrawMenuBar;
                    IF BitAnd(modIFiers, changeFlag) <> 0 THEN
                        UpdateEdit(FALSE);
                END
            ELSE
                BEGIN
                    HiliteControl(FlashControl, inactive);
                    DisableItem(FileMenu, 0);
                    DisableItem(PatMenu, 0);
                    DrawMenuBar;
                    IF BitAnd(modIFiers, changeFlag) <> 0 THEN
                        UpdateEdit(TRUE);
                END;
        END;
END;

PROCEDURE HandleAnEvent;
BEGIN
    CASE theEvent.what OF
        MouseDown :
            HandleMDown;
        KeyDown, AutoKey :
            HandleKDown;
        UpdateEvt :
            HandleUpdate;
        ActivateEvt :
            HandleActivate;
    END;
END;

PROCEDURE MainLoop;
BEGIN
    SystemTask;
    IF GetNextEvent(EveryEvent, theEvent) THEN
        HandleAnEvent;
    IF Flashing THEN
        CheckFlash;
END;

BEGIN (*  main program  *)
Init;
MakeMenus;
MakeWindow;
Finished := FALSE;
REPEAT
    MainLoop;
UNTIL Finished;
LoseWindow(myWindow);
FlushEvents(everyEvent, 0);
END.